home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / PICTEDIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  20.9 KB  |  749 lines

  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {        Copyright (c) 1995, 1997 Borland International }
  9. {        Portions copyright (c) 1995, 1996 AO ROSNO     }
  10. {        Portions copyright (c) 1997 Master-Bank        }
  11. {                                                       }
  12. {*******************************************************}
  13.  
  14. unit PictEdit;
  15.  
  16. {$I RX.INC}
  17.  
  18. interface
  19.  
  20. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  21.   Messages, Classes, Graphics, Forms, Controls, Dialogs, Buttons,
  22.   RTLConsts, DesignIntf, DesignEditors, VCLEditors, StdCtrls, ExtCtrls, Placemnt, ClipMon,
  23.   {$IFDEF RX_D3} ExtDlgs, ComCtrls, {$ELSE} ImagPrvw, {$ENDIF} Menus,
  24.   MRUList, RXCtrls;
  25.  
  26. type
  27.  
  28. { TPictureEditDialog }
  29.  
  30.   TPictureEditDialog = class(TForm)
  31.     Load: TButton;
  32.     Save: TButton;
  33.     Copy: TButton;
  34.     Paste: TButton;
  35.     Clear: TButton;
  36.     OKButton: TButton;
  37.     CancelButton: TButton;
  38.     HelpBtn: TButton;
  39.     DecreaseBox: TCheckBox;
  40.     UsePreviewBox: TCheckBox;
  41.     FormStorage: TFormStorage;
  42.     GroupBox: TGroupBox;
  43.     ImagePanel: TPanel;
  44.     ImagePaintBox: TPaintBox;
  45.     Bevel: TBevel;
  46.     Paths: TButton;
  47.     PathsBtn: TRxSpeedButton;
  48.     PathsMenu: TPopupMenu;
  49.     PathsMRU: TMRUManager;
  50.     procedure FormCreate(Sender: TObject);
  51.     procedure FormDestroy(Sender: TObject);
  52.     procedure LoadClick(Sender: TObject);
  53.     procedure SaveClick(Sender: TObject);
  54.     procedure ClearClick(Sender: TObject);
  55.     procedure CopyClick(Sender: TObject);
  56.     procedure PasteClick(Sender: TObject);
  57.     procedure HelpBtnClick(Sender: TObject);
  58.     procedure FormStorageRestorePlacement(Sender: TObject);
  59.     procedure FormStorageSavePlacement(Sender: TObject);
  60.     procedure ImagePaintBoxPaint(Sender: TObject);
  61.     procedure PathsClick(Sender: TObject);
  62.     procedure PathsMRUClick(Sender: TObject; const RecentName,
  63.       Caption: string; UserData: Longint);
  64.     procedure PathsMenuPopup(Sender: TObject);
  65.     procedure PathsMRUChange(Sender: TObject);
  66.   private
  67.     FGraphicClass: TGraphicClass;
  68.     Pic: TPicture;
  69.     FIconColor: TColor;
  70.     FClipMonitor: TClipboardMonitor;
  71. {$IFDEF RX_D3}
  72.     FProgress: TProgressBar;
  73.     FProgressPos: Integer;
  74.     FileDialog: TOpenPictureDialog;
  75.     SaveDialog: TSavePictureDialog;
  76. {$ELSE}
  77.     FileDialog: TOpenDialog;
  78.     SaveDialog: TSaveDialog;
  79. {$ENDIF}
  80.     procedure CheckEnablePaste;
  81.     procedure ValidateImage;
  82.     procedure DecreaseBMPColors;
  83.     procedure SetGraphicClass(Value: TGraphicClass);
  84.     function GetDecreaseColors: Boolean;
  85.     procedure LoadFile(const FileName: string);
  86.     procedure UpdatePathsMenu;
  87.     procedure UpdateClipboard(Sender: TObject);
  88.     procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  89.     procedure WMDestroy(var Msg: TMessage); message WM_DESTROY;
  90. {$IFDEF RX_D3}
  91.     procedure GraphicProgress(Sender: TObject; Stage: TProgressStage;
  92.       PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
  93. {$ENDIF}
  94.   protected
  95.     procedure CreateHandle; override;
  96.   public
  97.     property DecreaseColors: Boolean read GetDecreaseColors;
  98.     property GraphicClass: TGraphicClass read FGraphicClass write SetGraphicClass;
  99.   end;
  100.  
  101. { TPictEditor }
  102.  
  103.   TPictEditor = class(TComponent)
  104.   private
  105.     FGraphicClass: TGraphicClass;
  106.     FPicture: TPicture;
  107.     FPicDlg: TPictureEditDialog;
  108.     FDecreaseColors: Boolean;
  109.     procedure SetPicture(Value: TPicture);
  110.     procedure SetGraphicClass(Value: TGraphicClass);
  111.   public
  112.     constructor Create(AOwner: TComponent); override;
  113.     destructor Destroy; override;
  114.     function Execute: Boolean;
  115.     property PicDlg: TPictureEditDialog read FPicDlg;
  116.     property GraphicClass: TGraphicClass read FGraphicClass write SetGraphicClass;
  117.     property Picture: TPicture read FPicture write SetPicture;
  118.   end;
  119.  
  120. { TPictProperty }
  121.  
  122. { Property editor the TPicture properties (e.g. the Picture property). Brings
  123.   up a file open dialog allowing loading a picture file. }
  124.  
  125.   TPictProperty = class(TPropertyEditor)
  126.   public
  127.     procedure Edit; override;
  128.     function GetAttributes: TPropertyAttributes; override;
  129.     function GetValue: string; override;
  130.     procedure SetValue(const Value: string); override;
  131.   end;
  132.  
  133. { TGraphicPropertyEditor }
  134.  
  135.   TGraphicPropertyEditor = class(TClassProperty)
  136.   public
  137.     procedure Edit; override;
  138.     function GetAttributes: TPropertyAttributes; override;
  139.     function GetValue: string; override;
  140.     procedure SetValue(const Value: string); override;
  141.   end;
  142.  
  143. { TGraphicsEditor }
  144.  
  145.   TGraphicsEditor = class(TDefaultEditor)
  146.   public
  147.     procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override;
  148.   end;
  149.  
  150. function EditGraphic(Graphic: TGraphic; AClass: TGraphicClass;
  151.   const DialogCaption: string): Boolean;
  152.  
  153. implementation
  154.  
  155. uses TypInfo, SysUtils, Clipbrd, Consts, ShellApi, LibHelp, ClipIcon, RxGraph,
  156.   VCLUtils, AppUtils, RxConst, RxDirFrm, FileUtil;
  157.  
  158. {$B-}
  159. {$IFDEF WIN32}
  160.  {$D-}
  161. {$ENDIF}
  162.  
  163. {$R *.DFM}
  164.  
  165. procedure CopyPicture(Pict: TPicture; BackColor: TColor);
  166. begin
  167.   if Pict.Graphic <> nil then begin
  168.     if Pict.Graphic is TIcon then CopyIconToClipboard(Pict.Icon, BackColor)
  169.     { check another specific graphic types here }
  170.     else Clipboard.Assign(Pict);
  171.   end;
  172. end;
  173.  
  174. procedure PastePicture(Pict: TPicture; GraphicClass: TGraphicClass);
  175. var
  176.   NewGraphic: TGraphic;
  177. begin
  178.   if (Pict <> nil) then begin
  179.     if Clipboard.HasFormat(CF_ICON) and ((GraphicClass = TIcon) or
  180.       (GraphicClass = TGraphic)) then
  181.     begin
  182.       NewGraphic := CreateIconFromClipboard;
  183.       if NewGraphic <> nil then
  184.         try
  185.           Pict.Assign(NewGraphic);
  186.         finally
  187.           NewGraphic.Free;
  188.         end;
  189.     end
  190.     { check another specific graphic types here }
  191.     else if Clipboard.HasFormat(CF_PICTURE) then
  192.       Pict.Assign(Clipboard);
  193.   end;
  194. end;
  195.  
  196. function EnablePaste(Graph: TGraphicClass): Boolean;
  197. begin
  198.   if (Graph = TBitmap) then Result := Clipboard.HasFormat(CF_BITMAP)
  199.   else if (Graph = TMetafile) then Result := Clipboard.HasFormat(CF_METAFILEPICT)
  200.   else if (Graph = TIcon) then Result := Clipboard.HasFormat(CF_ICON)
  201.   { check another graphic types here }
  202.   else if (Graph = TGraphic) then Result := Clipboard.HasFormat(CF_PICTURE)
  203.   else Result := Clipboard.HasFormat(CF_PICTURE);
  204. end;
  205.  
  206. function ValidPicture(Pict: TPicture): Boolean;
  207. begin
  208.   Result := (Pict.Graphic <> nil) and not Pict.Graphic.Empty;
  209. end;
  210.  
  211. { TPictEditor }
  212.  
  213. constructor TPictEditor.Create(AOwner: TComponent);
  214. begin
  215.   inherited Create(AOwner);
  216.   FPicture := TPicture.Create;
  217.   FPicDlg := TPictureEditDialog.Create(Self);
  218.   FGraphicClass := TGraphic;
  219.   FPicDlg.GraphicClass := FGraphicClass;
  220. end;
  221.  
  222. destructor TPictEditor.Destroy;
  223. begin
  224.   FPicture.Free;
  225.   inherited Destroy;
  226. end;
  227.  
  228. function TPictEditor.Execute: Boolean;
  229. var
  230.   Bmp: TBitmap;
  231.   CurDir: string;
  232. begin
  233.   FPicDlg.Pic.Assign(FPicture);
  234.   with FPicDlg.FileDialog do
  235.   begin
  236.     Options := [ofHideReadOnly, ofFileMustExist, ofShowHelp];
  237.     DefaultExt := GraphicExtension(GraphicClass);
  238.     Filter := GraphicFilter(GraphicClass);
  239.     HelpContext := hcDLoadPicture;
  240.   end;
  241.   with FPicDlg.SaveDialog do
  242.   begin
  243.     Options := [ofHideReadOnly, ofFileMustExist, ofShowHelp,
  244.       ofOverwritePrompt];
  245.     DefaultExt := GraphicExtension(GraphicClass);
  246.     Filter := GraphicFilter(GraphicClass);
  247.     HelpContext := hcDSavePicture;
  248.   end;
  249.   FPicDlg.ValidateImage;
  250.   CurDir := GetCurrentDir;
  251.   try
  252.     Result := FPicDlg.ShowModal = mrOK;
  253.   finally
  254.     SetCurrentDir(CurDir);
  255.   end;
  256.   FDecreaseColors := FPicDlg.DecreaseColors;
  257.   if Result then begin
  258.     if FPicDlg.Pic.Graphic <> nil then begin
  259.       if (GraphicClass = TBitmap) and (FPicDlg.Pic.Graphic is TIcon) then
  260.       begin
  261.         Bmp := CreateBitmapFromIcon(FPicDlg.Pic.Icon, FPicDlg.FIconColor);
  262.         try
  263.           if FPicDlg.DecreaseColors then
  264.             SetBitmapPixelFormat(Bmp, pf4bit, DefaultMappingMethod);
  265.           FPicture.Assign(Bmp);
  266.         finally
  267.           Bmp.Free;
  268.         end;
  269.       end
  270.       else FPicture.Assign(FPicDlg.Pic);
  271.     end
  272.     else FPicture.Graphic := nil;
  273.   end;
  274. end;
  275.  
  276. procedure TPictEditor.SetGraphicClass(Value: TGraphicClass);
  277. begin
  278.   FGraphicClass := Value;
  279.   if FPicDlg <> nil then FPicDlg.GraphicClass := Value;
  280. end;
  281.  
  282. procedure TPictEditor.SetPicture(Value: TPicture);
  283. begin
  284.   FPicture.Assign(Value);
  285. end;
  286.  
  287. { Utility routines }
  288.  
  289. function EditGraphic(Graphic: TGraphic; AClass: TGraphicClass;
  290.   const DialogCaption: string): Boolean;
  291. var
  292.   PictureEditor: TPictEditor;
  293. begin
  294.   Result := False;
  295.   if Graphic = nil then Exit;
  296.   PictureEditor := TPictEditor.Create(nil);
  297.   try
  298.     PictureEditor.FPicDlg.Caption := DialogCaption;
  299.     PictureEditor.GraphicClass := AClass;
  300.     if AClass = nil then
  301.       PictureEditor.GraphicClass := TGraphicClass(Graphic.ClassType);
  302.     PictureEditor.Picture.Assign(Graphic);
  303.     Result := PictureEditor.Execute;
  304.     if Result then
  305.       if (PictureEditor.Picture.Graphic = nil) or
  306.          (PictureEditor.Picture.Graphic is PictureEditor.GraphicClass) then
  307.         Graphic.Assign(PictureEditor.Picture.Graphic)
  308.       else Result := False;
  309.   finally
  310.     PictureEditor.Free;
  311.   end;
  312. end;
  313.  
  314. { TPictProperty }
  315.  
  316. procedure TPictProperty.Edit;
  317. var
  318.   PictureEditor: TPictEditor;
  319.   Comp: TPersistent;
  320. begin
  321.   PictureEditor := TPictEditor.Create(nil);
  322.   try
  323.     Comp := GetComponent(0);
  324.     if Comp is TComponent then
  325.       PictureEditor.FPicDlg.Caption := TComponent(Comp).Name + '.' + GetName;
  326.     PictureEditor.Picture := TPicture(Pointer(GetOrdValue));
  327.     if PictureEditor.Execute then
  328.       SetOrdValue(Longint(PictureEditor.Picture));
  329.   finally
  330.     PictureEditor.Free;
  331.   end;
  332. end;
  333.  
  334. function TPictProperty.GetAttributes: TPropertyAttributes;
  335. begin
  336.   Result := [paDialog];
  337. end;
  338.  
  339. function TPictProperty.GetValue: string;
  340. var
  341.   Picture: TPicture;
  342. begin
  343.   Picture := TPicture(GetOrdValue);
  344.   if Picture.Graphic = nil then Result := ResStr(srNone)
  345.   else Result := '(' + Picture.Graphic.ClassName + ')';
  346. end;
  347.  
  348. procedure TPictProperty.SetValue(const Value: string);
  349. begin
  350.   if Value = '' then SetOrdValue(0);
  351. end;
  352.  
  353. { TGraphicPropertyEditor }
  354.  
  355. procedure TGraphicPropertyEditor.Edit;
  356. var
  357.   PictureEditor: TPictEditor;
  358.   Comp: TPersistent;
  359. begin
  360.   PictureEditor := TPictEditor.Create(nil);
  361.   try
  362.     Comp := GetComponent(0);
  363.     if Comp is TComponent then
  364.       PictureEditor.FPicDlg.Caption := TComponent(Comp).Name + '.' + GetName
  365.     else PictureEditor.FPicDlg.Caption := GetName;
  366.     PictureEditor.GraphicClass := TGraphicClass(GetTypeData(GetPropType)^.ClassType);
  367.     PictureEditor.Picture.Graphic := TGraphic(Pointer(GetOrdValue));
  368.     if PictureEditor.Execute then
  369.       if (PictureEditor.Picture.Graphic = nil) or
  370.          (PictureEditor.Picture.Graphic is PictureEditor.GraphicClass) then
  371.         SetOrdValue(LongInt(PictureEditor.Picture.Graphic))
  372.       else raise Exception.Create(ResStr(SInvalidPropertyValue));
  373.   finally
  374.     PictureEditor.Free;
  375.   end;
  376. end;
  377.  
  378. function TGraphicPropertyEditor.GetAttributes: TPropertyAttributes;
  379. begin
  380.   Result := [paDialog];
  381. end;
  382.  
  383. function TGraphicPropertyEditor.GetValue: string;
  384. var
  385.   Graphic: TGraphic;
  386. begin
  387.   Graphic := TGraphic(GetOrdValue);
  388.   if (Graphic = nil) or Graphic.Empty then Result := ResStr(srNone)
  389.   else Result := '(' + Graphic.ClassName + ')';
  390. end;
  391.  
  392. procedure TGraphicPropertyEditor.SetValue(const Value: string);
  393. begin
  394.   if Value = '' then SetOrdValue(0);
  395. end;
  396.  
  397. { TGraphicsEditor }
  398.  
  399. procedure TGraphicsEditor.EditProperty(const Prop: IProperty; var Continue: Boolean);
  400. var
  401.   PropName: string;
  402. begin
  403.   PropName := Prop.GetName;
  404.   if (CompareText(PropName, 'PICTURE') = 0) or
  405.     (CompareText(PropName, 'IMAGE') = 0) or
  406.     (CompareText(PropName, 'GLYPH') = 0) then
  407.   begin
  408.     Prop.Edit;
  409.     Continue := False;
  410.   end;
  411. end;
  412.  
  413. { TPictureEditDialog }
  414.  
  415. procedure TPictureEditDialog.SetGraphicClass(Value: TGraphicClass);
  416. begin
  417.   FGraphicClass := Value;
  418.   CheckEnablePaste;
  419.   DecreaseBox.Enabled := (GraphicClass = TBitmap) or (GraphicClass = TGraphic);
  420. end;
  421.  
  422. procedure TPictureEditDialog.CheckEnablePaste;
  423. begin
  424.   Paste.Enabled := EnablePaste(GraphicClass);
  425. end;
  426.  
  427. procedure TPictureEditDialog.ValidateImage;
  428. var
  429.   Enable: Boolean;
  430. begin
  431.   Enable := ValidPicture(Pic);
  432.   Save.Enabled := Enable;
  433.   Clear.Enabled := Enable;
  434.   Copy.Enabled := Enable;
  435. end;
  436.  
  437. {$IFDEF RX_D3}
  438. procedure TPictureEditDialog.GraphicProgress(Sender: TObject; Stage: TProgressStage;
  439.   PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
  440. begin
  441.   if Stage in [psStarting, psEnding] then begin
  442.     FProgressPos := 0;
  443.     FProgress.Position := 0;
  444.   end
  445.   else if Stage = psRunning then begin
  446.     if PercentDone >= FProgressPos + 10 then begin
  447.       FProgress.Position := PercentDone;
  448.       FProgressPos := PercentDone;
  449.     end;
  450.   end;
  451.   if RedrawNow then ImagePaintBox.Update;
  452. end;
  453. {$ENDIF}
  454.  
  455. procedure TPictureEditDialog.UpdateClipboard(Sender: TObject);
  456. begin
  457.   CheckEnablePaste;
  458. end;
  459.  
  460. procedure TPictureEditDialog.FormCreate(Sender: TObject);
  461. begin
  462.   Pic := TPicture.Create;
  463. {$IFDEF RX_D3}
  464.   FileDialog := TOpenPictureDialog.Create(Self);
  465.   SaveDialog := TSavePictureDialog.Create(Self);
  466.   UsePreviewBox.Visible := False;
  467.   FProgress := TProgressBar.Create(Self);
  468.   with FProgress do begin
  469.     SetBounds(UsePreviewBox.Left, UsePreviewBox.Top, UsePreviewBox.Width,
  470.       UsePreviewBox.Height);
  471.     Parent := Self;
  472.     Min := 0; Max := 100;
  473.     Position := 0;
  474.   end;
  475.   Pic.OnProgress := GraphicProgress;
  476. {$ELSE}
  477.   FileDialog := TOpenDialog.Create(Self);
  478.   SaveDialog := TSaveDialog.Create(Self);
  479. {$ENDIF}
  480.   FileDialog.Title := 'Load picture';
  481.   SaveDialog.Title := 'Save picture as';
  482. {$IFDEF WIN32}
  483.   Bevel.Visible := False;
  484.   Font.Style := [];
  485.   with FormStorage do begin
  486.     UseRegistry := True;
  487.     IniFileName := SDelphiKey;
  488.   end;
  489. {$ELSE}
  490.   if NewStyleControls then Font.Style := [];
  491. {$ENDIF}
  492.   PathsMRU.RecentMenu := PathsMenu.Items;
  493.   FIconColor := clBtnFace;
  494.   HelpContext := hcDPictureEditor;
  495.   Save.Enabled := False;
  496.   Clear.Enabled := False;
  497.   Copy.Enabled := False;
  498.   FClipMonitor := TClipboardMonitor.Create(Self);
  499.   FClipMonitor.OnChange := UpdateClipboard;
  500.   CheckEnablePaste;
  501. end;
  502.  
  503. function TPictureEditDialog.GetDecreaseColors: Boolean;
  504. begin
  505.   Result := DecreaseBox.Checked;
  506. end;
  507.  
  508. procedure TPictureEditDialog.FormDestroy(Sender: TObject);
  509. begin
  510.   FClipMonitor.Free;
  511.   Pic.Free;
  512. end;
  513.  
  514. procedure TPictureEditDialog.LoadFile(const FileName: string);
  515. begin
  516.   Application.ProcessMessages;
  517.   StartWait;
  518.   try
  519.     Pic.LoadFromFile(FileName);
  520.   finally
  521.     StopWait;
  522.   end;
  523.   ImagePaintBox.Invalidate;
  524.   ValidateImage;
  525. end;
  526.  
  527. procedure TPictureEditDialog.LoadClick(Sender: TObject);
  528. {$IFNDEF RX_D3}
  529. var
  530.   FileName: string;
  531. {$ENDIF}
  532. begin
  533. {$IFNDEF RX_D3}
  534.   if UsePreviewBox.Checked then begin
  535.     FileName := '';
  536.     if DirExists(FileDialog.InitialDir) then
  537.       SetCurrentDir(FileDialog.InitialDir);
  538.     if SelectImage(FileName, GraphicExtension(GraphicClass),
  539.       GraphicFilter(GraphicClass)) then
  540.     begin
  541.       FileDialog.Filename := FileName;
  542.       Self.LoadFile(FileName);
  543.     end;
  544.   end
  545.   else begin
  546. {$ENDIF}
  547.     if FileDialog.Execute then begin
  548.       Self.LoadFile(FileDialog.Filename);
  549.     end;
  550. {$IFNDEF RX_D3}
  551.   end;
  552. {$ENDIF}
  553. end;
  554.  
  555. procedure TPictureEditDialog.SaveClick(Sender: TObject);
  556. begin
  557.   if (Pic.Graphic <> nil) and not Pic.Graphic.Empty then begin
  558.     with SaveDialog do begin
  559.       DefaultExt := GraphicExtension(TGraphicClass(Pic.Graphic.ClassType));
  560.       Filter := GraphicFilter(TGraphicClass(Pic.Graphic.ClassType));
  561.       if Execute then begin
  562.         StartWait;
  563.         try
  564.           Pic.SaveToFile(Filename);
  565.         finally
  566.           StopWait;
  567.         end;
  568.       end;
  569.     end;
  570.   end;
  571. end;
  572.  
  573. procedure TPictureEditDialog.DecreaseBMPColors;
  574. begin
  575.   if ValidPicture(Pic) and (Pic.Graphic is TBitmap) and DecreaseColors then
  576.     SetBitmapPixelFormat(Pic.Bitmap, pf4bit, DefaultMappingMethod);
  577. end;
  578.  
  579. procedure TPictureEditDialog.CopyClick(Sender: TObject);
  580. begin
  581.   CopyPicture(Pic, FIconColor);
  582. end;
  583.  
  584. procedure TPictureEditDialog.PasteClick(Sender: TObject);
  585. begin
  586.   if (Pic <> nil) then begin
  587.     PastePicture(Pic, GraphicClass);
  588.     DecreaseBMPColors;
  589.     ImagePaintBox.Invalidate;
  590.     ValidateImage;
  591.   end;
  592. end;
  593.  
  594. procedure TPictureEditDialog.ImagePaintBoxPaint(Sender: TObject);
  595. var
  596.   DrawRect: TRect;
  597.   SNone: string;
  598. {$IFDEF WIN32}
  599.   Ico: HIcon;
  600.   W, H: Integer;
  601. {$ENDIF}
  602. begin
  603.   with TPaintBox(Sender) do begin
  604.     Canvas.Brush.Color := Color;
  605.     DrawRect := ClientRect;
  606.     if ValidPicture(Pic) then begin
  607.       with DrawRect do
  608.         if (Pic.Width > Right - Left) or (Pic.Height > Bottom - Top) then
  609.         begin
  610.           if Pic.Width > Pic.Height then
  611.             Bottom := Top + MulDiv(Pic.Height, Right - Left, Pic.Width)
  612.           else
  613.             Right := Left + MulDiv(Pic.Width, Bottom - Top, Pic.Height);
  614.           Canvas.StretchDraw(DrawRect, Pic.Graphic);
  615.         end
  616.         else begin
  617.           with DrawRect do begin
  618. {$IFDEF WIN32}
  619.             if Pic.Graphic is TIcon then begin
  620.               Ico := CreateRealSizeIcon(Pic.Icon);
  621.               try
  622.                 GetIconSize(Ico, W, H);
  623.                 DrawIconEx(Canvas.Handle, (Left + Right - W) div 2,
  624.                   (Top + Bottom - H) div 2, Ico, W, H, 0, 0, DI_NORMAL);
  625.               finally
  626.                 DestroyIcon(Ico);
  627.               end;
  628.             end else
  629. {$ENDIF}
  630.             Canvas.Draw((Right + Left - Pic.Width) div 2,
  631.               (Bottom + Top - Pic.Height) div 2, Pic.Graphic);
  632.           end;
  633.         end;
  634.     end
  635.     else
  636.       with DrawRect, Canvas do begin
  637.         SNone := ResStr(srNone);
  638.         TextOut(Left + (Right - Left - TextWidth(SNone)) div 2, Top + (Bottom -
  639.           Top - TextHeight(SNone)) div 2, SNone);
  640.       end;
  641.   end;
  642. end;
  643.  
  644. procedure TPictureEditDialog.CreateHandle;
  645. begin
  646.   inherited CreateHandle;
  647.   DragAcceptFiles(Handle, True);
  648. end;
  649.  
  650. procedure TPictureEditDialog.WMDestroy(var Msg: TMessage);
  651. begin
  652.   DragAcceptFiles(Handle, False);
  653.   inherited;
  654. end;
  655.  
  656. procedure TPictureEditDialog.WMDropFiles(var Msg: TWMDropFiles);
  657. var
  658.   AFileName: array[0..255] of Char;
  659.   Num: Cardinal;
  660. begin
  661.   Msg.Result := 0;
  662.   try
  663.     Num := DragQueryFile(Msg.Drop, {$IFDEF WIN32} $FFFFFFFF {$ELSE}
  664.       $FFFF {$ENDIF}, nil, 0);
  665.     if Num > 0 then begin
  666.       DragQueryFile(Msg.Drop, 0, PChar(@AFileName), Pred(SizeOf(AFileName)));
  667.       Application.BringToFront;
  668.       Self.LoadFile(StrPas(AFileName));
  669.     end;
  670.   finally
  671.     DragFinish(Msg.Drop);
  672.   end;
  673. end;
  674.  
  675. procedure TPictureEditDialog.UpdatePathsMenu;
  676. var
  677.   I: Integer;
  678. begin
  679.   for I := 0 to PathsMenu.Items.Count - 1 do begin
  680.     PathsMenu.Items[I].Checked := CompareText(PathsMenu.Items[I].Caption,
  681.       FileDialog.InitialDir) = 0;
  682.   end;
  683. end;
  684.  
  685. procedure TPictureEditDialog.ClearClick(Sender: TObject);
  686. begin
  687.   Pic.Graphic := nil;
  688.   ImagePaintBox.Invalidate;
  689.   Save.Enabled := False;
  690.   Clear.Enabled := False;
  691.   Copy.Enabled := False;
  692. end;
  693.  
  694. procedure TPictureEditDialog.HelpBtnClick(Sender: TObject);
  695. begin
  696.   Application.HelpContext(HelpContext);
  697. end;
  698.  
  699. const
  700.   sBackColorIdent = 'ClipboardBackColor';
  701.   sFileDir = 'FileDialog.InitialDir';
  702.  
  703. procedure TPictureEditDialog.FormStorageRestorePlacement(Sender: TObject);
  704. begin
  705.   FIconColor := TColor(IniReadInteger(FormStorage.IniFileObject,
  706.     FormStorage.IniSection, sBackColorIdent, clBtnFace));
  707.   FileDialog.InitialDir := IniReadString(FormStorage.IniFileObject,
  708.     FormStorage.IniSection, sFileDir, FileDialog.InitialDir);
  709. end;
  710.  
  711. procedure TPictureEditDialog.FormStorageSavePlacement(Sender: TObject);
  712. begin
  713.   IniWriteInteger(FormStorage.IniFileObject, FormStorage.IniSection,
  714.     sBackColorIdent, FIconColor);
  715.   IniWriteString(FormStorage.IniFileObject, FormStorage.IniSection,
  716.     sFileDir, FileDialog.InitialDir);
  717. end;
  718.  
  719. procedure TPictureEditDialog.PathsClick(Sender: TObject);
  720. begin
  721.   if EditFolderList(PathsMRU.Strings) then
  722.     UpdatePathsMenu;
  723. end;
  724.  
  725. procedure TPictureEditDialog.PathsMRUClick(Sender: TObject;
  726.   const RecentName, Caption: string; UserData: Longint);
  727. begin
  728.   if DirExists(RecentName) then begin
  729.     {SetCurrentDir(RecentName);}
  730.     FileDialog.InitialDir := RecentName;
  731.   end
  732.   else begin
  733.     PathsMRU.Remove(RecentName);
  734.   end;
  735.   UpdatePathsMenu;
  736. end;
  737.  
  738. procedure TPictureEditDialog.PathsMenuPopup(Sender: TObject);
  739. begin
  740.   UpdatePathsMenu;
  741. end;
  742.  
  743. procedure TPictureEditDialog.PathsMRUChange(Sender: TObject);
  744. begin
  745.   PathsBtn.Enabled := PathsMRU.Strings.Count > 0;
  746. end;
  747.  
  748. end.
  749.